#!/usr/bin/perl
#
# Fill out a form. Attempts to use the latest and greatest
# in OO technology....
# Assumes that rec is a HASH with names (in lowercase) as keys.
# Does NOT offer (yet) fill-in of anything but INPUT type fields
#
package FillForm;

# Trace option.
$DEBUG = 0;

use HTML::TreeBuilder;

sub fillform {
    my($rec, $filename) = @_;
    my $doc;
    $doc = new HTML::TreeBuilder;
    $doc->ignore_unknown(0);
    $doc->parse_file($filename);
    #warn "Parsed file $filename: ", $doc->as_HTML;
    my %intrec;
    for $key (keys(%$rec)) {
	# make all the stuff into arrays for multivalue
	$intrec{$key} = [split(", ", $$rec{$key})];
    }
# Now traverse the document looking for INPUT type elements
    $doc->traverse(
	       sub {
		   my ($node, $startflag, $depth) = @_;
		   if ($node->tag() eq "input") {
		       #warn "Input tag: ", $node->as_HTML, " $startflag\n";
		       $name = $node->attr("name");
		       if ($node->attr("type") eq "checkbox" && $intrec{$name}) {
			   $value = $node->attr("value");
			   my $ix;
			   for $ix (0..$#{$intrec{$name}}) {
			       my $val = ${$intrec{$name}}[$ix];
			       if ($val eq $value) {
				   $node->attr("checked", "");
				   $DEBUG && warn "Checked $name $val\n";
				   splice(@{$intrec{$name}}, $ix, 1); # remove matched
			       }
			   }
		       } else {
			   # Text field.
			   # Put everything into it, comma separated.
			   # NOTE: this isn't optimal...
			   if ($name && $intrec{$name}) {
			       $val = join(", ", @{$intrec{$name}});
			       $DEBUG && warn "Set $name to $val\n";
			       $node->attr("value", $val);
			   }
		       }
		   } elsif ($node->tag() eq "select") {
		       $name = $node->attr("name");
		       if ($startflag) {
			   $lookfor = $name;
			   $optfound = 0;
		       } else {
			   $lookfor = "";
		       }
		   } elsif ($node->tag() eq "option") {
		       my $ix;
		       my $found = 0;
		       $val = $node->attr(value);
		       if (!$optfound) { # Only trigger once per option set
			 loop: for $ix (0..$#{$intrec{$lookfor}}) {
			     my $val = ${$intrec{$lookfor}}[$ix];
			     if ($node->attr("value") eq $val) {
			         $node->attr("selected", "");
			         splice(@{$intrec{$lookfor}}, $ix, 1); # remove matched
			         $DEBUG && warn "Selected option $lookfor $val\n";
			         $optfound = 1;
			         $found = 1;
			     }
		         }
		       }
                       if (!$found && $node->attr("selected")) {
			   delete_attr($node, "selected");
		       }
                   } elsif ($node->tag eq "textarea") {
                       $name = $node->attr("name");
                       if ($startflag && $intrec{$name}) {
			   my $newsection = join(", ", @{$intrec{$name}});
			   my $newsec = new HTML::TreeBuilder();
			   $newsec->ignore_unknown(0);
			   $newsec->implicit_tags(0);
			   $newsec->parse($newsection);
			   $newsec->eof();
			   $node->delete_content();
			   #$DEBUG && 
			       warn "Set $name to ", $newsec->as_HTML, "\n";
			   # for obscure reasons, parser SOMETIMES inserts empty HEAD and BODY elms
			   # in front....not consistent with working code in replace_section
			   my @content = @{$newsec->content()};
			   shift @content
			       if ref($content[0]) && 
				   $content[0]->tag() eq "head";; # <HEAD>
			   shift @content
			       if ref($content[0]) && 
				   $content[0]->tag() eq "body";; # <BODY>
			   $node->push_content(@content);
		       }
		   }
		   1;
	       }, # end of anon subroutine
    1); # 1 - don't look at text elements
    return $doc;
}

sub replace_section {
    my ($doc, $id, $newsection) = @_;
# Now traverse the document looking for a specific span section
    # Parse the new section into HTML (pray this works)
    my $newsec = new HTML::TreeBuilder();
    $newsec->ignore_unknown(0);
    $newsec->implicit_tags(0);
    $newsec->parse($newsection);
    $newsec->eof();
    $doc->traverse(
	       sub {
		   my ($node, $startflag, $depth) = @_;
		   return 1 if (!$startflag);
		   if ($node->tag() eq "span"
		       || $node->tag() eq "div") {
		       $name = $node->attr("id");
		       #warn "span id=$name\n";
		       if ($name eq $id) {
			   $DEBUG &&
			       warn "Set $name to ", $newsec->as_HTML, "\n";
			   $node->delete_content();
			   $node->push_content(@{$newsec->content()});
		       }
		   }
		   1;
	       }, # end of anon subroutine
    1); # 1 - don't look at text elements

}

# Change the form with id "id" to have target URL "target"

sub change_form_target {
    my ($doc, $id, $newtarget) = @_;
    # Parse the new section into HTML (pray this works)

    $doc->traverse(
	       sub {
		   my ($node, $startflag, $depth) = @_;
		   return 1 if (!$startflag);
		   if ($node->tag() eq "form") {
		       $name = $node->attr("id");
		       #warn "span id=$name\n";
		       if ($name eq $id) {
			   $DEBUG && 
			       warn "Changing target of form $id\n";
			   $node->attr("action", $newtarget)
		       }
		   }
		   1;
	       }, # end of anon subroutine
    1); # 1 - don't look at text elements

}

sub delete_attr {
    my ($node, $attribute) = @_;
    # This is a hack - HTML::Element should have provided this
    delete $node->{$attribute};
}

1;
